perm filename RAND[226,DBL] blob sn#043415 filedate 1973-05-21 generic text, type T, neo UTF8
00100	(DE RANDOM () (QUOTIENT
00200		(BOOLE 1 (LSH (RANDM) -3) 7777777777) _RD))
00300	
00400	(LAP RANDM SUBR)
00500		(MOVE 1 (SPECIAL _RX))
00600		(220000 1 (SPECIAL _RA))
00700		(ADD 1 (C  15460 0 616031))
00800		(404000 1 (C 377777 0 777777))
00900		(MOVEM 1 (SPECIAL _RX))
01000		(MOVEI 2 (QUOTE FIXNUM))
01100		(CALL 2 (E MAKNUM))
01200		(POPJ P)
01300		NIL
01400	
01500	(DE INITRAND () (PROG (N)
01600		(SETQ _RD (PLUS 10000000000 0.0))
01700		(INITRAND1)
01800		(SETQ N (ADD1 (REMAINDER (TIME) 100)))
01900	LOOP	(COND ((GREATERP (SETQ N (SUB1 N)) 0)
02000			(RANDOM)  (GO LOOP)))
02100		(RETURN NIL)  ]
02200	
02300	(LAP INITRAND1 SUBR)
02400		(MOVE 1 (C 0 0 61356))
02500		(MOVEM 1 (SPECIAL _RX))
02600		(MOVE 1 (C 37556 0 736271))
02700		(MOVEM 1 (SPECIAL _RA))
02800		(POPJ P)
02900		NIL
03000	
03100	(DE SHUFFLE (DECK) (SHUF2 (LENGTH DECK) (LENGTH DECK) DECK))
03200	
03300	(DE SHUF2 (N TOT DECK) (COND
03400	  ((ZEROP N) DECK)
03500	  (T (SHUF2 (SUB1 N) TOT (EXCHANGE DECK N
03600	       (ADD1 (FIX (TIMES TOT (RANDOM]
03700	
03800	(DE EXCHANGE (L N M) (COND
03900	  ((*LESS M N) (EX2 L M N))
04000	((EQUAL N M) L)
04100	  (T (EX2 L N M]
04200	
04300	(DE EX2 (L N M) (COND
04400	  ((EQUAL N 1) (SETQ TEMP (CAR L)) (CONS (NTH M L) 
04500	        (EX2 (CDR L) (SUB1 N) (SUB1 M))))
04600	  ((EQUAL M 1) (CONS TEMP (CDR L)))
04700	  (T (CONS (CAR L) (EX2 (CDR L) (SUB1 N) (SUB1 M]
04800	
04900	(DE NTH (N L) (COND
05000	  ((EQUAL N 1) (CAR L))
05100	  (T (NTH (SUB1 N) (CDR L]
05200	
05300	(SETQ DECK1 (QUOTE (A 2. 3. 4. 5. 6. 7. 8. 9. 10. J Q K]
05400	
05500	(SETQ DECK2 (APPEND DECK1 DECK1]
05600	(SETQ DECK (APPEND DECK2 DECK2]